home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / autodesk.arc / CL.LSP < prev    next >
Encoding:
Text File  |  1987-04-29  |  2.4 KB  |  80 lines
  1. ;*************************** CL.LSP **************************************
  2.  
  3. ;    By Simon Jones    Autodesk Ltd , London      March 1987
  4.  
  5. ;  This macro constructs a pair of of centre lines through the
  6. ;  centre of a circle. The lines are put on a layer "CENTER".
  7.  
  8.  
  9. (defun C:CL (/ clay sblip scmde e cen rad d ts xx)
  10.    (setq clay (getvar "CLAYER"))
  11.    (setq sblip (getvar "BLIPMODE"))
  12.    (setq scmde (getvar "CMDECHO"))
  13.    (setvar "CMDECHO" 0)
  14.    (setq e nil xx "Yes")
  15.    (setq ts (tblsearch "LAYER" "CENTER"))
  16.    (if (null ts)
  17.        (prompt "\nCreating new layer - CENTER. ")
  18.        (progn
  19.         (if (= (cdr (assoc 70 ts)) 1)
  20.             (progn
  21.              (prompt "\nLayer CENTER is frozen. ")
  22.              (initget  "Yes No")
  23.              (setq xx (getkword "\nProceed (Y/N) <No>: "))
  24.              (if (= xx "Yes")
  25.                  (command "LAYER" "T" "CENTER" "")
  26.              )
  27.             )
  28.         )
  29.        )
  30.    )
  31.  
  32.    (if (= xx "Yes")
  33.       (progn
  34.        (while (null e)
  35.           (setq e (entsel "\nSelct arc or circle: "))
  36.           (if e
  37.               (progn
  38.                (setq e (car e))
  39.                (if (and
  40.                      (/= (cdr (assoc 0 (entget e))) "ARC")
  41.                      (/= (cdr (assoc 0 (entget e))) "CIRCLE")
  42.                    )
  43.                    (progn (prompt "\nEntity is a ")
  44.                           (princ (cdr (assoc 0 (entget e))))
  45.                           (setq e nil)
  46.                    )
  47.                )
  48.               )
  49.           )
  50.        )
  51.        (setq cen (cdr (assoc 10 (entget e))))
  52.        (setq rad (cdr (assoc 40 (entget e))))
  53.        (prompt "\nRadius is ")
  54.        (princ (rtos rad))
  55.        (initget 1 "Length")
  56.        (setq d (getdist "\n<Extension>/Length: "))
  57.        (if (= d "Length")
  58.         (progn
  59.          (initget 1)
  60.          (setq d (getdist cen "\nLength: "))
  61.         )
  62.         (setq d (+ rad d))
  63.        )
  64.        (setvar "BLIPMODE" 0)
  65.        (command "LAYER" "M" "CENTER" "LT" "CENTER" "CENTER" "")
  66.        (command "LINE" (list (car cen) (- (cadr cen) d))
  67.                        (list (car cen) (+ (cadr cen) d))
  68.                        ""
  69.        )
  70.        (command "LINE" (list (- (car cen) d) (cadr cen))
  71.                        (list (+ (car cen) d) (cadr cen))
  72.                        ""
  73.        )
  74.        (command "LAYER" "S" clay "")
  75.       )
  76.    )
  77.    (setvar "BLIPMODE" sblip)
  78.    (setvar "CMDECHO" scmde)
  79.    (princ)
  80. )